          SUBROUTINE (INIT.CID,VIEW.ONLY,NADA,BATCH,AMT)
** Version# 45 - 02/15/2008 - 12:31pm - KEVINM - main

*** SUBROUTINE: CR.MISC
*-------------------------------------------------------------------------*
*** This routine allows the user to enter Miscelaneous Cash Receipts.
*** These are Cash Receipts that are not tied specifically to a Sales
*** Order.
*-------------------------------------------------------------------------*
*** INIT.CID  - Initial Cash Receipt ID (if wanting to view existing  (IN)
*** VIEW.ONLY - Whether the View should be View Only or not.          (IN)
*** NADA      - This arguement is currently not used. If you need to  (IN)
***             add an arguement please reuse this one.
*** BATCH     - Batch number for new misc. cash receipt.              (IN)
*** AMT       - Amount of cash to alocate for this misc. cash receipt (IN)
*-------------------------------------------------------------------------*
*** Common Variables: LED,OID.DATA$,BLINK$,NORM$
*-------------------------------------------------------------------------*
          SCREEN
          VSCROLL.DEFINE 1,1,8,72,10,'CR.MISC'
          VSCROLL.SET 1

          * Screen positions are XCoor,YCoor,Lgth @VM delimited
          SCRPOS    = ''
          SCRPOS<1> = 9:VM:1:VM:11  ;* Batch#
          SCRPOS<2> = 9:VM:2:VM:60  ;* Bank
          SCRPOS<3> = 58:VM:1:VM:10 ;* Post Date
          SCRPOS<4> = 34:VM:1:VM:4  ;* Branch
*-------------------------------------------------------------------------*
START:    *** Clear screen and get ready for display/entry of a new receipt
          CLEAR.SCREEN
          VCLR

          OID.DATA$<1> = ''
          IF INIT.CID THEN
             * Make sure the record already exists in LEDGER otherwise
             * this is still a new misc. cash receipt with the @ID
             * already being set.
             CID = FIELD(INIT.CID,'.',1)
             READV EXISTS FROM LEDFILE,CID,0 ELSE EXISTS = ''
             IF NOT(EXISTS) THEN ENTER.HEADER = YES ELSE ENTER.HEADER = NO
          END ELSE
             ENTER.HEADER = YES; EXISTS = NO
          END

          IF ENTER.HEADER THEN
             * Prompt the user for a batch#, bank account, post date,
             * and branch then grab a list of receipts which match
             * the given criteria
             CR.BATCH BATCH,BANK.ID,BANK.DESC,POST.DATE,CBR,SCRPOS,YES
             IF QUIT THEN GOTO FINISH
             CR.MISC.SEL.IDS CBR,BANK.ID,POST.DATE,IDS
             * If the post date is in a closed period they can recall
             * an existing cash receipt that si passed in or that is in
             * the ID this but they will be put in view only.
             CHK.GL.POST POST.DATE,OK,'C'
             IF NOT(OK) THEN VIEW.ONLY = YES
          END

          * If the cash receipt does not exists but a @ID was passed in
          * there is no reason to pop a menu table asking for new as
          * it is implied so by the calling routine passing in this @ID
          LOAD.NEW = (NOT(EXISTS) AND INIT.CID)
          BEGIN CASE
          CASE LOAD.NEW; GOSUB NEWREC
          CASE INIT.CID; GOSUB OLDREC
          CASE OTHERWISE
             IF VIEW.ONLY AND NOT(IDS) THEN GOTO START
             IDS = INSERT(IDS,1,1;'NEW')
             MENU.TABLE CID,5,2,1,10,66,'CALL MISC.CR.SELECT.CONV',1,IDS
             BEGIN CASE
             CASE CID = 'NEW'; CID = ''; GOSUB NEWREC  ;* New receipt
             CASE CID = '';              GOTO  START   ;* Abort
             CASE CID # '';              GOSUB OLDREC  ;* Recall
             END CASE
          END CASE

          OID.DATA$<1> = CID
          IF VIEW.ONLY THEN
             LINE = 1; COL = 1
             PRINT @(55,0):BLINK$:'View Only':NORM$
INPVV:       INPV A,0,LINE,0
             IF QUIT THEN GOTO FINISH
             * Let MOVENEXT handle the movement and then just
             * freeze the user back up at the INPV above
             GOSUB MOVENEXT; GOTO INPVV
          END ELSE
             * Load hotkeys and skip down to the comment field
             * as the header will have already been entered
             GOSUB LOAD.HKEYS
             GOTO INCMNT
          END
*-------------------------------------------------------------------------*
REHEADER: *** Allow users to reenter header information
          CHKGLDT = YES
          CR.BATCH BATCH,BANK.ID,BANK.DESC,POST.DATE,CBR,SCRPOS,CHKGLDT
          LED(2)  = CBR:SVM:CBR:SVM:CBR
          LED(23) = POST.DATE
          LOCATE 'CASH' IN LED(24)<1,1> SETTING POS ELSE NULL
          LED(24)<1,1,POS> = 'CASH'
          LED(25)<1,1,POS> = CBR:'~':BANK.ID
          LED(28) = BATCH
          IF QUIT THEN GOTO FILEIT
          ON MOVE+1 GOTO REHEADER,REHEADER,REHEADER,REHEADER
*-------------------------------------------------------------------------*
*** Comments
INCMNT:   INP LED(80),2,4,55
          IF QUIT THEN GOTO FILEIT
          ON MOVE+1 GOTO INCMNT,INCMNT,REHEADER,INCMNT
*-------------------------------------------------------------------------*
*** Receipt amount
INAMT:    INP AMT,8,6,12,'MR2'
          IF QUIT THEN GOTO FILEIT
          AMT = ICONV(AMT*XRATE,'MR0')
          LED(26)<1,1,1> = AMT
          GOSUB REFRESH.BALANCE
          ON MOVE+1 GOTO INAMT,INAMT,INCMNT,INAMT
*-------------------------------------------------------------------------*
          MOVE = 0; LASTKEY = ''; LINE = 1; COL = 1; NEWOK = NO; DNOK = YES
*-------------------------------------------------------------------------*
MOVENEXT: *** Handle movements throughout the vscroll region
          LINES = DCOUNT(LED(25)<1,1>,SVM)-1
          DNOK  = (LINE < LINES)
          NEWOK = (FIELD(LED(25)<1,1,LINE+1>,'~',2)#'')
          PARSEMOVE COL,LINE,4,LINES,10,DNOK,NEWOK,BORDERMOVE
          IF QUIT THEN GOTO FILEIT
          OLDBRGL = LED(25)<1,1,LINE+1>
          BR      = FIELD(OLDBRGL,'~',1)
          GLN     = FIELD(OLDBRGL,'~',2)

          * If GL number then look up to see if SubLedgers are allowed
          IF GLN # '' THEN
            READV SL.ALLOWED FROM GLFILE,GLN,31 ELSE SL.ALLOWED = 'N'
            IF SL.ALLOWED = '' THEN SL.ALLOWED = 'N'
          END ELSE SL.ALLOWED = 'N'

          IF VIEW.ONLY THEN RETURN
          IF BORDERMOVE = 2 THEN GOTO INAMT
          ON COL GOTO INBR,INGL,INSUBL,INCAMT
*-------------------------------------------------------------------------*
*** Branch
INBR:     TERR.TYPE = -1; ALLOK = ''; NULLOK = YES
INPBR:    INPV.BR 0,LINE,4,BR,,,TERR.TYPE,ALLOK,NULLOK,,'R'
          IF QUIT THEN GOTO FILEIT
          IF BR THEN
             OLDBRGL = LED(25)<1,1,LINE+1>
             LED(25)<1,1,LINE+1> = BR:'~':FIELD(OLDBRGL,'~',2)
          END
          GOTO MOVENEXT
*-------------------------------------------------------------------------*
*** G/L Account
INGL:     IF BR = '' THEN COL = 1; GOTO INBR
INGLN:    INPV GLN,5,LINE,35,V_'S:VERF.GL,ARM~':BR
          IF LASTKEY = 0 THEN LASTKEY = 13 ;* Force movement to amount
          IF CHANGED OR HELP THEN
             IF GLN = '' THEN GOTO INGL
             VPRINT 5,LINE,OCONV(GLN,'TGENLED;X;3;3') 'L#35'
             VSCROLL.GET.VER LINE,VER
             OLDBRGL = LED(25)<1,1,LINE+1>
             IF LED(26)<1,1,LINE+1>+0#0 AND GLN='' THEN
                PRINT BELL:; GOTO INGL
             END
             * Theoretically a new G/L account so clear the subledger
             * ID so it is probally not valid anymore
             SUB.ID = ''
             VPRINT 43,LINE,SUB.ID "L#10"
             LED(24)<1,1,LINE+1> = ''
             LED(25)<1,1,LINE+1> = FIELD(OLDBRGL,'~',1):'~':GLN
          END
          GOTO MOVENEXT
*-------------------------------------------------------------------------*
INSUBL:   *** Get SubLedger ID
          *** Check to see if SubLedgers Allowed for this GL Account Number
          *** If not send them to the Amount Column
          IF SL.ALLOWED = 'N' THEN GOTO INCAMT

          * Call standard SubLedger Input logic
IN.SUB:   GL.SUB.LEDGER.INP GLN,43,LINE,SUB.ID,VALS,ERRS

          * Handle the Errors
          IF ERRS THEN
             * ERRS is made up of two fields which are seperated by a ~
             * The first field is the Err Number the second is the msg.
             E.NUM = FIELD(ERRS,'~',1)
             E.MSG = FIELD(ERRS,'~',2)

             * If error message then display it
             IF E.MSG THEN
                ERR.MESS 19,5,BELL:E.MSG
             END

             BEGIN CASE
             * Error with G/L Number
             CASE E.NUM = 1; GOTO INGL
             * They hit F12 or Escape
             CASE E.NUM = 4; GOTO FILEIT
             * They hit a HotKey
             CASE E.NUM = 6
                GOSUB SUBS
                GOTO IN.SUB
             * All Other Errors go back to input
             CASE OTHERWISE; GOTO IN.SUB
             END CASE
          END

          * VALS will hold any return values from the input routine.
          * This may be a single value or multiple values.
          IF VALS # '' THEN
             NUM.VALS  = DCOUNT(VALS,AM)
             SV.LINE   = LINE
             FOR VL.CT = 1 TO NUM.VALS
                IF VL.CT > 1 THEN
                   LINE += 1
                   * Save current GL setting to copy to other lines
                   LED(25)<1,1,LINE+1> = SV.LED25

                   * Insert Line.
                   LED(24) = INSERT(LED(24),1,1,LINE+1;'')
                   LED(25) = INSERT(LED(25),1,1,LINE+1;'')
                   LED(26) = INSERT(LED(26),1,1,LINE+1;0)
                   VINS LINE
                   LAST.LINE = ''
                   LED(25)<1,1,LINE+1> = SV.LED25
                END ELSE
                   * Save Information from original line in case there
                   * are multiple lines selected.
                   SV.LED25 = LED(25)<1,1,LINE+1>
                   BR       = FIELD(SV.LED25,'~',1)
                   GLN      = FIELD(SV.LED25,'~',2)
                END
                SUB.ID = VALS<VL.CT>
                * Set Up LED24 and the print results to screen
                LED(24)<1,1,LINE+1> = '^':SUB.ID
                VPRINT  0,LINE,BR"R#4"
                VPRINT  5,LINE,OCONV(GLN,'TGENLED;X;3;3') 'L#35'
                VPRINT 43,LINE,SUB.ID"L#10"
                AMT = -LED(26)<1,1,LINE+1>
                IF AMT = 0 THEN
                   VPRINT 54,LINE,''                      'R26#12'
                END ELSE
                   VPRINT 54,LINE,ICONV(AMT/XRATE,'MR0')  'R26#12'
                END
             NEXT VL.CT
             LINE = SV.LINE
             COL = 3
          END ELSE
             * If No valid value returned then return to input.
             SUB.ID = ''
             VPRINT 43,LINE,'' 'L#10'
          END
          GOTO MOVENEXT
*-------------------------------------------------------------------------*
*** Amount
INCAMT:   IF BR  = '' THEN COL = 1; GOTO INBR
          IF GLN = '' THEN COL = 2; GOTO INGL
INPCAMT:  INPV GAMT,54,LINE,12,'MR2'
          GAMT = ICONV(GAMT*XRATE,'MR0')
          LED(26)<1,1,LINE+1> = -GAMT
          GOSUB REFRESH.BALANCE
          GOTO MOVENEXT
*-------------------------------------------------------------------------*
DISP.HDR: *** Display header information
          GL.ID     = LED(25)<1,1,1>
          CBR       = FIELD(GL.ID,'~',1)
          BANK.ID   = FIELD(GL.ID,'~',2)
          BATCH     = LED(28)
          POST.DATE = LED(23)
          PRINT @(9,1):BATCH                              'L#11'
          PRINT @(34,1):CBR                               'L#4'
          PRINT @(58,1):OCONV(POST.DATE,'D4/')            'L#10'
          PRINT @(9,2):OCONV(BANK.ID,'TGENLED;X;4;4')     'L#60'
          RETURN
*-------------------------------------------------------------------------*
DISP.IMG: *** Check for any images attached to this receipt
          CHECK.FOR.IMAGES CID,'L',IMAGE.FLAG
          IF IMAGE.FLAG THEN
             PRINT @(62,0):BLINK$:'*i*':NORM$
          END
          RETURN
*-------------------------------------------------------------------------*
DISPLAY:  *** Display the body of the screen containing the total amount
          *** unapplied, and G/L table
          PRINT @(9,1):LED(28)<1>                         'L#11'
          PRINT @(8,6):ICONV(LED(26)<1,1,1>/XRATE,'MR0')  'R26#12'
          PRINT @(2,4):LED(80)                            'L#55'

          LINES    = DCOUNT(LED(26)<1,1>,SVM)
          FOR LINE = 2 TO LINES
             WORK  = LED(25)<1,1,LINE>
             BR    = FIELD(WORK,'~',1)
             GLN   = FIELD(WORK,'~',2)

             IF GLN = GL.AUTO.XCH THEN
                * Remove any prior inter branch exchange as
                * this will get recalculated when the receipt is posted
                LED(24) = DELETE(LED(24),1,1,LINE)
                LED(25) = DELETE(LED(25),1,1,LINE)
                LED(26) = DELETE(LED(26),1,1,LINE)
                LINE -= 1; LINES -= 1; CONTINUE
             END

             READV GLDESC FROM GLFILE,GLN,3 ELSE GLDESC = ''
             CONVERT VM TO ' ' IN GLDESC
             AMT   = -LED(26)<1,1,LINE>
             SL.ID = FIELD(LED(24)<1,1,LINE>,'^',2)

             VPRINT  0,LINE-1,BR                     'R#4'   ;* Branch
             VPRINT  5,LINE-1,GLDESC                 'L#35'  ;* G/L account
             VPRINT 43,LINE-1,SL.ID                  'L#10'  ;* Subledger
             VPRINT 54,LINE-1,ICONV(AMT/XRATE,'MR0') 'R26#12';* Amount
          NEXT LINE

          GOSUB REFRESH.BALANCE
          RETURN
*-------------------------------------------------------------------------*
REFRESH.BALANCE:*** Recalc and retotal the balance field
          GL.REC  = LED(26)
          BALANCE = LED(26)<1,1,1> + SUMMATION(GL.REC[SVM,2,999])
          PRINT @(30,6):ICONV(BALANCE/XRATE,'MR0') 'R26#12'
          RETURN
*-------------------------------------------------------------------------*
NEWREC:   *** Start up a new misc cash receipt by loading the basic LEDGER
          *** values for post date, branch, cash account and batch#
          MAT LED = ''
          LED(2)  = CBR:SVM:CBR:SVM:CBR     ;* Ship/Price/GL branches
          LED(8)  = 1                       ;* Single generation
          LED(23) = POST.DATE               ;* Post Date
          LED(24) = 'CASH'                  ;* Cash account
          LED(25)<1,1,1> = CBR:'~':BANK.ID  ;* G/L branch~Bank account
          LED(26)<1,1,1> = AMT              ;* Receipt amount
          LED(28)        = BATCH            ;* Batch#

          XTYPE   = ''                      ;* Exchange type
          XRATE   = 1                       ;* Exchange rate
          NEWITEM = YES                     ;* New receipt flag
          IF NOT(INIT.CID) THEN             ;* Initial CR @ID
             GET.NEW.ID 'CASH.REC',CID,'C','R%':(OID.LGTH$-1),LEDFILE
          END

          GOSUB DISP.HDR
          GOSUB DISPLAY
          GOSUB REFRESH.BALANCE
          RETURN
*-------------------------------------------------------------------------*
OLDREC:   *** Load Ledger record for an existing misc. cash receipt
          IF NOT(VIEW.ONLY) THEN
             OE.LOCK.LED CID,LOCK.ERR
             IF LOCK.ERR THEN VIEW.ONLY = YES
          END ELSE
             MATREAD LED FROM LEDFILE,CID ELSE MAT LED = ''
          END

          XTYPE = LED(92)<1,1,1>
          IF XTYPE THEN
             XRATE = OCONV(LED(92)<1,1,2>,'MR4')
             PRINT @(2,0):BLINK$:TRIM(XTYPE "R#7":' - ':XRATE "L4#9"):NORM$
          END ELSE XRATE = 1

          CBR       = LED(2)<1,1,3>
          POST.DATE = LED(23)
          BANK.ID   = FIELD(LED(25)<1,1,1>,'~',2)
          READV BANK.DESC FROM GLFILE,BANK.ID,2 ELSE GL.DESC = ''
          BATCH     = LED(28)
          NEWITEM   = NO

          * If the post date is in a closed period they can recall
          * an existing cash receipt that si passed in or that is in
          * the ID this but they will be put in view only.
          CHK.GL.POST POST.DATE,OK,'C'
          IF NOT(OK) THEN VIEW.ONLY = YES

          GOSUB DISP.HDR
          GOSUB DISP.IMG
          GOSUB DISPLAY
          RETURN
*-------------------------------------------------------------------------*
LOAD.HKEYS:*** Load hotkey definitions
          MENU.LOAD 67,0,1,1,'$'
          MENU.LOAD ,,,,'4'
          MENU.LOAD ,,,,INSERT.KEY
          MENU.LOAD ,,,,DELETE.KEY
          RETURN
*-------------------------------------------------------------------------*
SUBS:     ON OPTION GOTO XCURR,XCURR,INS.LN,DEL.LN
*-------------------------------------------------------------------------*
XCURR:    *** Show the current foreign exchange rate and allow the
          *** user to change to another currency
          SVLED9 = LED(9)
          LED(9) = POST.DATE

          OE.XCURR.MAINT CID,1,REDISP

          LED(9) = SVLED9
          XTYPE  = LED(92)<1,1,1>
          XRATE  = OCONV(LED(92)<1,1,2>,'MR4')

          * If there is a exchange currency defined, there is a post
          * condition that a rate must be defined.
          IF NOT(XRATE) AND XTYPE THEN
             E.MESS  = BELL:'You must define an exchange rate'
             E.MESS := AM:'for a foreign currency'
             ERR.MESS 5,5,E.MESS,YES
             GOTO XCURR
          END

          * Show what currency they're using on the top of the screen.
          PRINT @(2,0):''
          IF XTYPE # '' THEN
             CURR = BLINK$:TRIM(XTYPE "R#7":' - ':XRATE "L4#9"):NORM$
             PRINT @(2,0):CURR
          END ELSE
             XRATE = 1
          END

          * Redisplay the screen...
          IF REDISP THEN
             GOSUB DISPLAY
             PRINT @(30,6):ICONV(BALANCE/XRATE,'MR0') "R26#12"
          END
          RETURN
*-------------------------------------------------------------------------*
INS.LN:   *** Insert a line in the table
          LED(24) = INSERT(LED(24),1,1,LINE+1;'')
          LED(25) = INSERT(LED(25),1,1,LINE+1;'')
          LED(26) = INSERT(LED(26),1,1,LINE+1;'')
          VINS LINE
          MOVE = 0; LASTKEY = 0; COL = 1
          RETURN TO MOVENEXT
*-------------------------------------------------------------------------*
DEL.LN:   *** Delete a line in the table
          LED(24) = DELETE(LED(24),1,1,LINE+1)
          LED(25) = DELETE(LED(25),1,1,LINE+1)
          LED(26) = DELETE(LED(26),1,1,LINE+1)
          VDEL LINE
          MOVE = 0; LASTKEY = 0
          GOSUB REFRESH.BALANCE
          RETURN TO MOVENEXT
*-------------------------------------------------------------------------*
FILEIT:   *** Save the users changes
          BEGIN CASE
          CASE VIEW.ONLY; NULL
          CASE F12
             CONFIRM.ABORT SURE
             IF NOT(SURE) THEN GOTO INAMT
             OE.UNLOCK.LED CID
             IF CID AND NEWITEM THEN
                * Try and reuse the cash receipt @ID
                ID = CID[2,9]
                REUSE.ID 'CASH.REC',ID+0
             END
          CASE OTHERWISE
             IF LINES = 0 AND CID = '' THEN GOTO START
             IF LED(2)<1,1,1> = ''     THEN PRINT BELL:; GOTO REHEADER
             IF LED(23) = ''           THEN PRINT BELL:; GOTO REHEADER
             IF FIELD(LED(25)<1,1,1>,'~',2)='' THEN
                PRINT BELL:; GOTO REHEADER
             END
             GL.CT = DCOUNT(LED(25)<1,1>,SVM)
             FOR GLP = GL.CT TO 2 STEP -1
                IF LED(26)<1,1,GLP>+0 = 0 OR LED(25)<1,1,GLP> = '' THEN
                   * If we don't have a valid branch or account then
                   * delete the line item
                   LED(24) = DELETE(LED(24),1,1,GLP)
                   LED(25) = DELETE(LED(25),1,1,GLP)
                   LED(26) = DELETE(LED(26),1,1,GLP)
                END
             NEXT X

             * In case we removed anything in the loop above we need to
             * refresh the balance to make sure we have an accurate amount
             GOSUB REFRESH.BALANCE
             IF BALANCE+0 # 0 THEN PRINT BELL:; GOTO INAMT
             IF CID = '' THEN
                GET.NEW.ID 'CASH.REC',CID,'C','R%:'OID.LGTH$-1,LEDFILE
             END
             UPDATE.LEDGER CID,1
             OE.UNLOCK.LED CID
          END CASE
          IF NOT(INIT.CID) THEN
             * Need to clear out the amount here
             * otherwise the same amount will be show for the next
             * misc cash receipts
             AMT = ''
             GOTO START
          END
*-------------------------------------------------------------------------*
FINISH:   *** Close window and exit
          WINDOW.CLOSE
          RETURN
*-------------------------------------------------------------------------*
!KEVINM~02/15/08~12:31
